home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
program
/
pcl4p51.zip
/
SIMPLE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-06-05
|
5KB
|
175 lines
(*********************************************)
(* *)
(* SIMPLE.PAS June 96 *)
(* *)
(* SIMPLE is provided as the simpliest *)
(* possible terminal program using PCL4P *)
(* *)
(* This program is donated to the Public *)
(* Domain by MarshallSoft Computing, Inc. *)
(* It is provided as an example of the use *)
(* of the Personal Communications Library. *)
(* *)
(*********************************************)
program simple;
uses crt, PCL4P;
var
BaudCode : Integer;
RetCode : Integer;
Byte : Char;
i : Integer;
Port : Integer;
ResetFlag : Boolean;
BufPtr : Pointer;
BufSeg : Integer;
procedure SayError( Code : Integer );
var
RetCode : Integer;
begin
if Code < 0 then RetCode := SioError( Code )
else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
begin (* Port Error *)
if (Code and FramingError) <> 0 then writeln('Framing Error');
if (Code and ParityError) <> 0 then writeln('Parity Error');
if (Code and OverrunError) <> 0 then writeln('Overrun Error')
end
end;
procedure MyHalt( Code : Integer );
var
RetCode : Integer;
begin
if Code < 0 then SayError( Code );
if ResetFlag then RetCode := SioDone(Port);
writeln('*** HALTING ***');
Halt;
end;
function MatchBaud(BaudString : String) : Integer;
const
BaudRateArray : array[1..10] of LongInt =
(300,600,1200,2400,4800,9600,19200,38400,57600,115200);
var
i : Integer;
BaudRate: LongInt;
RetCode : Integer;
begin
Val(BaudString,BaudRate,RetCode);
if RetCode <> 0 then
begin
MatchBaud := -1;
exit;
end;
for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
begin
MatchBaud := i - 1;
exit;
end;
(* no match *)
MatchBaud := -1;
end;
begin (* main program *)
ResetFlag := FALSE;
(* fetch PORT # from command line *)
if ParamCount <> 2 then
begin
writeln('USAGE: "SIMPLE <port> <baud rate>" where port = 1 to 20');
halt;
end;
Val( ParamStr(1),Port, RetCode );
if RetCode <> 0 then
begin
writeln('Port must be 1 to 16');
Halt;
end;
(* COM1 = 0, COM2 = 1, etc. *)
Port := Port - 1;
if (Port<COM1) or (Port>COM16) then
begin
writeln('Port must be 1 to 16');
Halt
end;
(* get baud rate *)
BaudCode := MatchBaud(ParamStr(2));
(* setup 1K receive buffer *)
GetMem(BufPtr,1024+16);
BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
RetCode := SioRxBuf(Port, BufSeg, Size1024);
if RetCode < 0 then MyHalt( RetCode );
if SioInfo('I') > 0 then
begin
(* setup 128 transmit buffer *)
GetMem(BufPtr,128+16);
BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
RetCode := SioTxBuf(Port, BufSeg, Size128);
if RetCode < 0 then MyHalt( RetCode );
end;
(* reset port *)
RetCode := SioReset(Port,BaudCode);
(* if error then try one more time *)
if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
(* Was port reset ? *)
if RetCode <> 0 then
begin
writeln('Cannot reset COM',Port+1);
MyHalt( RetCode );
end;
(* Port successfully reset *)
writeln;
writeln('COM',1+Port,' @ ',ParamStr(2));
ResetFlag := TRUE;
(* specify parity, # stop bits, and word length for port *)
RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
if RetCode < 0 then MyHalt( RetCode );
(* set FIFO level if have INS16550 *)
RetCode := SioFIFO(Port, LEVEL_8);
if RetCode < 0 then MyHalt( RetCode );
RetCode := SioRxClear(Port);
if RetCode < 0 then MyHalt( RetCode );
(* set DTR & RTS *)
RetCode := SioDTR(Port,SetPort);
RetCode := SioRTS(Port,SetPort);
(* begin terminal loop *)
writeln('Enter terminal loop ( Type ^Z to exit )');
while TRUE do
begin
(* did user press Ctrl-BREAK ? *)
if SioBrkKey then
begin
writeln('User typed Ctl-BREAK');
RetCode := SioDone(Port);
Halt;
end;
(* check for data overrun *)
if (SioLine(Port) AND OverrunError) <> 0 then writeln('Overrun!');
(* anything incoming over serial port ? *)
RetCode := SioGetc(Port,0);
if RetCode < -1 then MyHalt( RetCode );
if RetCode > -1 then Write( chr(RetCode) );
(* has user pressed keyboard ? *)
if KeyPressed then
begin
(* read keyboard *)
Byte := ReadKey;
(* quit if user types ^Z *)
if Byte = chr($1a) then
begin
writeln('User typed ^Z');
RetCode := SioDone(Port);
Halt;
end;
(* send out over serial line *)
RetCode := SioPutc(Port, Byte );
if RetCode < 0 then MyHalt( RetCode );
end
end
end.